home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / construc / COUNTED.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-21  |  3.1 KB  |  128 lines
  1. {$APPTYPE CONSOLE}
  2. {$I-}
  3. uses
  4.   SysUtils, DrBobDOS;
  5. var
  6.   f: Text;
  7.   i: Integer;
  8.   Back,Str: ShortString;
  9.   SRec: TSearchRec;
  10.  
  11. var
  12.   Data: ShortString;
  13.  
  14.   function Value(Const Field: ShortString): ShortString;
  15.   var
  16.     i: Integer;
  17.   begin
  18.     Result := '';
  19.     i := Pos(Field+'=',Data);
  20.     if i > 0 then
  21.     begin
  22.       Inc(i,Length(Field)+1);
  23.       while Data[i] <> '&' do
  24.       begin
  25.         Result := Result + Data[i];
  26.         Inc(i)
  27.       end
  28.     end
  29.   end {Value};
  30.  
  31. var
  32.   ContentLength: Integer;
  33.  
  34. begin
  35.   writeln('Content-type: text/html');
  36.   writeln;
  37.   writeln('<HTML>');
  38.   writeln('<BODY>');
  39.   writeln('<H1>Dr.Bob''s HITs Counter</H1>');
  40.   writeln('<HR>');
  41.   with TBDosEnvironment.Create(nil) do
  42.   try
  43.     for i:=0 to Pred(DosEnvCount) do
  44.     begin
  45.       if Pos('REQUEST_METHOD',DosEnvList[i]) > 0 then
  46.       begin
  47.         Data := DosEnvList[i];
  48.         Delete(Data,1,Pos('=',Data))
  49.       end
  50.     end;
  51.     if Data = 'POST' then
  52.     begin
  53.       ContentLength := StrToInt(GetDosEnvStr('CONTENT_LENGTH'));
  54.       for i:=1 to ContentLength do read(Data[i]);
  55.       Data[ContentLength+1] := '&' { catch-all }
  56.     end
  57.     else ContentLength := 0
  58.   finally
  59.     Free
  60.   end;
  61.   if ContentLength = 0 then
  62.   begin
  63.     writeln('<FORM ACTION="/cgi-bin/counted.exe?" METHOD=POST>');
  64.     writeln('Please specify the day to analyse:<BR>');
  65.     writeln('<SELECT NAME="log">');
  66.     if FindFirst('*.log',faArchive,SRec) = 0 then
  67.     repeat
  68.       writeln('<OPTION VALUE="',SRec.Name,'"> ',Copy(SRec.Name,1,4),'/',Copy(SRec.Name,5,2),'/',Copy(SRec.Name,7,2));
  69.     until FindNext(SRec) <> 0;
  70.     writeln('</SELECT>');
  71.     FindClose(SRec);
  72.     writeln('<P>');
  73.     writeln('<INPUT TYPE="RESET" VALUE="Reset">');
  74.     writeln('<INPUT TYPE="SUBMIT" VALUE="Get Hit Count Statistics">');
  75.     writeln('</FORM>');
  76.   end
  77.   else
  78.   begin
  79.     writeln('<CENTER>');
  80.     writeln('<TABLE BORDER>');
  81.     writeln('<TR><TD BGCOLOR="A7B7C7">No.</TD><TD BGCOLOR="A7B7C7">Date</TD><TD BGCOLOR="A7B7C7">Time</TD><TD BGCOLOR="A7B7C7">IP</TD><TD BGCOLOR="A7B7C7">Host</TD></TR>');
  82.     System.Assign(f,Value('log'));
  83.     reset(f);
  84.     if IOResult = 0 then while not eof(f) do
  85.     begin
  86.       readln(f,Str);
  87.       Str[Length(Str)+1] := #0;
  88.       write('<TR><TD',Back,'>');
  89.       i := 0;
  90.       repeat
  91.         Inc(i);
  92.         write(Str[i])
  93.       until Str[i+1] = ':';
  94.       write('</TD><TD',Back,'>');
  95.       repeat
  96.         Inc(i);
  97.       until Str[i+1] <> ' ';
  98.       repeat
  99.         Inc(i);
  100.         write(Str[i])
  101.       until Str[i+1] = ' ';
  102.       write('</TD><TD',Back,'>');
  103.       repeat
  104.         Inc(i);
  105.       until Str[i+1] <> ' ';
  106.       repeat
  107.         Inc(i);
  108.         write(Str[i])
  109.       until Str[i] = 'M';
  110.       write('</TD><TD',Back,'>');
  111.       repeat
  112.         Inc(i);
  113.       until Str[i+1] <> ' ';
  114.       repeat
  115.         Inc(i);
  116.         write(Str[i])
  117.       until i = Length(Str);
  118.       write('</TD><TD',Back,'>');
  119.       writeln('</TD></TR>')
  120.     end;
  121.     close(f);
  122.     writeln('</TABLE>');
  123.     writeln('</CENTER>')
  124.   end;
  125.   writeln('</BODY>');
  126.   writeln('</HTML>')
  127. end.
  128.